SuperHack/SuperHack CD.bin/CODING/DEMOS/DEMOSTUF.ZIP/LIGHT1.PAS

Pascal/Delphi Source File | 1994-07-25 | 9.5 KB | 574 lines

program lightsource1;
{
    Lightsourced (blenk, really) vector #1
    - by Bjarke Viksφe
    feb 1994

  THIS PROGRAM WAS CODED BY BJARKE VIKS0E.
  YOU ARE FREE TO DO WHATEVER YOU WANT WITH THIS PIECE OF CODE.
  E-MAIL ME AT: [e-mail] IN 1994 FOR CHAT AND CODE.

    Pretty basic. Rotate coords and draw polygons on screen. I use
    a different polygon-drawing scheme that all other coders on PC I think.
    Starting x-pos and ending x-pos are calculated for each horizontal
    line of the whole polygon before it's drawn on the screen.
    So we could technically do n-sided polygons just as easy.
    Takes too long time because of erasing of screen before drawing.
    Need to come up with some idea to skip that...
}

{$DEFINE DEBUG}

uses
    DEMOINIT;

const
    ANTAL_FACES = 6;
    ANTAL_COORDS = 8;
    box = 140; {size of box}

type
    facetype = RECORD
        l1,l2,l3,l4 : byte;
    end;

var
    slope                    : array[0..399] of integer;
    face                    : array[1..ANTAL_FACES] of facetype;
    light                    : array[1..ANTAL_FACES] of byte;
    cbuffer                : array[0..ANTAL_COORDS*2-1] of integer;

    miny,maxy             : integer;
    scrminy,scrmaxy     : integer;
    lastscrminy, lastscrmaxy : integer;

    sinustabel            : array[0..639] of integer;
    v1,v2,v3                : word;
    cos1,sin1,cos2,sin2,cos3,sin3 : integer;

    xkoord,ykoord,zkoord,
    n : integer;


const
    display1 : integer = $0000;
    display2 : integer = $4000;
    coords : array[0..ANTAL_COORDS*3-1] of integer =
        (box,box,-box, -box,box,-box, -box,-box,-box, box,-box,-box,
        box,box,box, -box,box,box, -box,-box,box, box,-box,box);


(*------------------------------------------------*)

procedure SetupSinus;
var
    i : integer;
    v, vadd : real;
begin
    v:=0.0;
    vadd:=(2.0*pi/512.0);
    for i:=0 to 639 do begin
        sinustabel[i]:=round(sin(v)*32767);
        v:=v+vadd;
    end;
end;

procedure SetupCoords;
begin
    with face[1] do begin l1:=3; l2:=2; l3:=1; l4:=0; end;
    with face[2] do begin l1:=4; l2:=5; l3:=6; l4:=7; end;
    with face[3] do begin l1:=0; l2:=1; l3:=5; l4:=4; end;
    with face[4] do begin l1:=1; l2:=2; l3:=6; l4:=5; end;
    with face[5] do begin l1:=2; l2:=3; l3:=7; l4:=6; end;
    with face[6] do begin l1:=3; l2:=0; l3:=4; l4:=7; end;
end;

procedure InitDemo;
var
    i : integer;
begin
    Screen_Off;
    ClearWholeScreen;
    SetupSinus;
    SetupCoords;

    scrminy := 0; scrmaxy := 200;
    lastscrminy := 0; lastscrmaxy := 200;
    v1:=0; v2:=0; v3:=0;
    Screen_On;
end;


(*------------------------------------------------*)

procedure SwapDisplay;
var
    temp : word;
begin
    temp:=display2;
    display2:=display1;
    display1:=temp;
    SetAddress(Ptr(SEGA000,display2));
end;

procedure ClearScreen(y1,y2 : integer); assembler;
asm
    mov    dx,$3C4
    mov    ax,$0F02
    out    dx,ax

    mov    bx,y1        {clear box around vector - only y-coords are actually}
    mov    dx,y2        {used for calculation... x-coords are constant}
    sub    dx,bx
    cmp    dx,200
    ja        @done

    lea    si,ytabel
    add    bx,bx
    mov    di,[si+bx]
    add    di,display1
    add    di,16

    mov    es,SEGA000
    DB LONG; xor ax,ax
    mov    bx,48/4
@loop:
    mov    cx,bx
    rep; DB LONG; stosw
    add    di,WIDTH-48
    dec    dl
    jnz    @loop
@done:
end;


(*------------------------------------------------*)

procedure ClearSlope; assembler;
asm
    mov    ax,ds
    mov    es,ax
    lea    di,slope
    DB LONG; mov ax,$8000; DW $8000;
    cld
    mov    cx,200
    rep; DB LONG; stosw
end;

procedure CalcSlope(l1,l2 : integer); assembler;
var
    ysize : integer;
asm
    lea    si,cbuffer
    mov    bx,l1
    shl    bx,2
    mov    cx,[si+bx]
    mov    dx,[si+bx+2]
    mov    bx,l2
    shl    bx,2
    add    si,bx
    mov    ax,[si]
    mov    bx,[si+2]

    cmp    bx,dx
    jle    @noswap
    xchg    ax,cx
    xchg    bx,dx
@noswap:
    cmp    bx,miny
    jae    @miny
    mov    miny,bx
@miny:
    cmp    dx,maxy
    jbe    @maxy
    mov    maxy,dx
@maxy:

    sub    dx,bx
    mov    ysize,dx
    add    bx,bx
    add    bx,bx
    lea    si,slope
    add    si,bx

    push    ax
    sub    cx,ax
    inc    cx

    and    dx,dx
    jz        @zero
    cmp    dl,1
    jne    @not1
    dec    cx
    mov    dx,cx
    xor    ax,ax
    jmp    NEAR PTR @one
@not1:
    cmp    dl,2
    jne    @not2
    mov    ax,$7FFF
    imul    cx
    jmp    NEAR PTR @one
@not2:

    mov    dx,$0001
    mov    ax,$0000
    idiv    ysize
    imul    cx
@one:
    pop    cx
    xor    bx,bx

    mov    di,$8000
@loop:
    cmp    [si],di
    jne    @other
    mov    [si],cx
    add    si,4
    add    bx,ax
    adc    cx,dx
    dec    ysize
    jnz    @loop
    jmp    NEAR PTR @zero
@other:
    mov    [si+2],cx
    add    si,4
    add    bx,ax
    adc    cx,dx
    dec    ysize
    jnz    @loop
@zero:
end;


(*------------------------------------------------*)

procedure CalcVinkel;
begin
    sin1:=sinustabel[v1]; cos1:=sinustabel[v1+128];
    sin2:=sinustabel[v2]; cos2:=sinustabel[v2+128];
    sin3:=sinustabel[v3]; cos3:=sinustabel[v3+128];
    v1:=(v1+2) AND 511;
    v2:=(v2-1) AND 511;
    v3:=(v3+1) AND 511;
end;

procedure RotateAllCoords; assembler;
{really fast assembly rotating around all three axis + perspective
 calculations. Takes an coord. array, coords, and puts rotated coords
 in cbuffer (only x,y are stored...)}
asm
    mov    ax,ds
    mov    es,ax
    lea    si,coords
    lea    di,cbuffer
    mov    n,ANTAL_COORDS
    cld
@loop:
    lodsw
    mov    xkoord,ax
    lodsw
    mov    ykoord,ax
    lodsw
    mov    zkoord,ax

    mov    ax,xkoord               {rotate around Z-axis}
    push    ax
    imul    Cos1
    add    ax,ax
    adc    dx,dx
    mov    bx,dx
    mov    ax,ykoord
    imul    Sin1
    add    ax,ax
    adc    dx,dx
    sub    bx,dx
    mov    xkoord,bx
    pop    ax
    imul    Sin1
    add    ax,ax
    adc    dx,dx
    mov    bx,dx
    mov    ax,ykoord
    imul    Cos1
    add    ax,ax
    adc    dx,dx
    add    bx,dx
    mov    ykoord,bx

    mov    ax,ykoord               {rotate around Y-axis}
    push    ax
    imul    Cos2
    add    ax,ax
    adc    dx,dx
    mov    bx,dx
    mov    ax,zkoord
    imul    Sin2
    add    ax,ax
    adc    dx,dx
    sub    bx,dx
    mov    ykoord,bx
    pop    ax
    imul    Sin2
    add    ax,ax
    adc    dx,dx
    mov    bx,dx
    mov    ax,zkoord
    imul    Cos2
    add    ax,ax
    adc    dx,dx
    add    bx,dx
    mov    zkoord,bx

    mov    ax,xkoord               {rotate around X-axis}
    push    ax
    imul    Cos3
    add    ax,ax
    adc    dx,dx
    mov    bx,dx
    mov    ax,zkoord
    imul    Sin3
    add    ax,ax
    adc    dx,dx
    sub   bx,dx
    mov    xkoord,bx
    pop    ax
    imul    Sin3
    add    ax,ax
    adc    dx,dx
    mov    bx,dx
    mov    ax,zkoord
    imul    Cos3
    add    ax,ax
    adc    dx,dx
    add    bx,dx
    mov    zkoord,bx

    add    bx,800
    and    bx,bx
    jnz    @zero
    mov    bl,1
@zero:

    mov        ax,xkoord
    cwd
    mov        dl,ah
    mov        ah,al
    xor        al,al
    idiv        bx
    add        ax,160
    stosw

    mov        ax,ykoord
    cwd
    mov        dl,ah
    mov        ah,al
    xor        al,al
    idiv        bx
    add        ax,100
    stosw

    dec        n
    jne        @loop
end;



function FaceShown(i : integer; l1,l2,l3 : byte) : boolean;
var
    a,b : longint;
begin
    a := longmul(cbuffer[l1]-cbuffer[l2],cbuffer[l3+1]-cbuffer[l2+1]);
    b := longmul(cbuffer[l1+1]-cbuffer[l2+1],cbuffer[l3]-cbuffer[l2]);
    light[i] := longdiv(a-b,200);
    FaceShown := (a-b) > 0;
end;


procedure FillShape(y,ysize : integer; color : byte); assembler;
const
    pixelarray1 : array[0..3] of byte = (0,14,12,8);
    pixelarray2 : array[0..3] of byte = (0,1,3,7);
asm
    cmp    ysize,200
    jae    @done
    mov    ax,y
    add    ax,ax
    mov    si,ax
    mov    di,[si+OFFSET ytabel]
    add    di,display1
    lea    si,slope
    add    ax,ax
    add    si,ax

    mov    es,SEGA000
    mov    bl,color                                { color in BL }
    {doing this outside is a bit risky}
    mov    dx,$3C4
    mov    al,$02
    out    dx,al
    {set dir.flag}
    cld
@yloop:
    lodsw
    mov    dx,ax
    lodsw
    cmp    ax,dx
    jle    @exchange
    xchg    ax,dx
@exchange:

    cmp    dx,0
    jl        @filledout_fast
    cmp    ax,320
    jge    @filledout_fast
    cmp    ax,0
    jge    @cut1
    xor    ax,ax
@cut1:
    cmp    dx,319
    jle    @cut2
    mov    dx,319
@cut2:
    push    si
    push    di

    mov    cx,dx
    sub    dx,ax
    mov    si,dx                                 { size in si at this moment... }

    mov    dx,ax                                    { get x pos }
    shr    ax,2
    add    di,ax
    shr    cx,2

    cmp    ax,cx                                    { size is <= 4 if on same }
    jne    @notsamebyte                        { byteoffset... special case }
    mov    cx,si
    and    cx,cx
    jz        @filledout
    mov    al,00001111b
    dec    cl
    xor    cl,3
    shr    al,cl
    mov    cl,dl
    and    cl,3
    shl    al,cl
    mov    dx,$3C5
    out    dx,al
    mov    al,bl
    stosb
    jmp    NEAR PTR @filledout
@notsamebyte:
    mov    cx,si

    and    dx,3                                {start painting a line}
    jz        @OnRightByte
    mov    si,dx
    mov    al,BYTE PTR pixelarray1+si
    dec    dl
    xor    dl,$03
    sub    cx,dx
    mov    dx,$3C5
    out    dx,al
    mov    al,bl
    stosb
@OnRightByte:

    mov    dx,$3C5
    mov    al,$F
    out    dx,al

    mov    al,bl

    mov    dx,cx
    test    di,1                            {make sure we fill word on even boundary}
    jz        @oneven                        {this check is actually worth it!}
    cmp    dx,4
    jl        @only4left
    stosb
    sub    dx,4
@oneven:

    mov    cx,dx                            {fill as many words we can}
    and    dx,7
    shr    cx,3
    jz        @only8left
    mov    ah,al
    rep stosw
@only8left:

    test    dl,4                            {also fill a possible whole last-byte}
    jz        @only4left
    stosb
    sub    dl,4
@only4left:

    and    dl,dl                            {and also the last few pixels}
    jz        @filledout
    mov    si,dx
    mov    dx,$3C5
    mov    al,BYTE PTR pixelarray2+si
    out    dx,al
    mov    al,bl
    stosb

@filledout:
    pop    di
    pop    si
@filledout_fast:
    add    di,WIDTH
    dec    ysize
    jnz    @yloop
@done:
end;


procedure RunOnce;
var
    i : integer;
begin
    SwapDisplay;
    VBLANK;
{$IFDEF DEBUG}
    SetRGB(0,30,0,0);
{$ENDIF}

    for i:=1 to ANTAL_FACES do    setRGB(i,light[i],light[i],light[i]);

    ClearScreen(lastscrminy,lastscrmaxy);

    lastscrminy := scrminy; lastscrmaxy := scrmaxy;
    scrminy := 200; scrmaxy := 0;

    CalcVinkel;
    RotateAllCoords;

    for i:=1 to ANTAL_FACES do begin
        with face[i] do if FaceShown(i, l1 shl 1,l2 shl 1,l3 shl 1) then begin
            ClearSlope;
            miny := 200; maxy := 0;
            CalcSlope(l1,l2);
            CalcSlope(l2,l3);
            CalcSlope(l3,l4);
            CalcSlope(l4,l1);
            FillShape(miny, maxy-miny, i);
            if (miny < scrminy) then scrminy := miny;
            if (maxy > scrmaxy) then scrmaxy := maxy;
        end;
    end;
{$IFDEF DEBUG}
    SetRGB(0,0,0,0);
{$ENDIF}
end;


begin
    OpenScreen;
    InitDemo;
    SetAllInterrupts;
    repeat RunOnce until Key='e';
    RestoreAllInterrupts;
    CloseScreen;
end.